home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / CO39 / BUTTONS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-10  |  12KB  |  408 lines
  1. {Buttons - Copyright (C) Doug Overmyer 7/1/91}
  2. unit Buttons;
  3. {************************  Interface    ***********************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects,WIN31,ShellAPI;
  6. const
  7.     um_ButtonU = 198;
  8.   um_ButtonD = 199;
  9.  
  10. type
  11.     hDrop=THandle;
  12. type  {OD Button uses internal .bmp resource }
  13. PODButton = ^TODButton;
  14. TODButton = object(TRadioButton)
  15.         HBmp :HBitmap;
  16.       State:Integer;
  17.       X,Y,W,H:Integer;
  18.     constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  19.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  20.     destructor    Done;virtual;
  21.     procedure    DrawItem(var Msg:TMessage);virtual;
  22.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  23. end;
  24.  
  25. PODDButton = ^TODDButton;{OD Button with D&D - .ICO file,extracted icon res, or internal bmp resource}
  26. TODDButton = object(TODButton)
  27.         SourceName:Array[0..79] of Char;
  28.     constructor Init(AParent:PwindowsObject;AnID:Integer;ATitle:PChar;
  29.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  30.     procedure SetupWindow;virtual;
  31.     function CanClose:Boolean;virtual;
  32.     procedure ChangeBMP(BMPFile:PChar);
  33.     procedure GetBMP;virtual;
  34.     procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  35. end;
  36.  
  37. PODGroupBox = ^TODGroupBox;    {Group box for TODButton }
  38. TODGroupBox = object(TGroupBox)
  39.       OldID:Integer;
  40.   constructor Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
  41.       X,Y,W,H:Integer);
  42.     procedure SelectionChanged(NewID:Integer);virtual;
  43. end;
  44.  
  45. PODDGroupBox = ^TODDGroupBox;  {Group box for TODDButton }
  46. TODDGroupBox = object(TODGroupBox)
  47.     procedure SetupWindow;virtual;
  48.   function CanClose:Boolean;virtual;
  49.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  50. end;
  51. {************************  Implementation      **********************}
  52. implementation
  53. const
  54.     SR_RECESSED = 1;
  55.   SR_RAISED   = 0;
  56. {************************  Functions     ****************************}
  57. {************************  DrawHiLites   ****************************}
  58. function DrawHilites(PaintDC:hDC;X1,Y1,X2,Y2,LW,State:Integer):Boolean;
  59. var
  60.   LPts,RPts:Array[0..2] of TPoint;
  61.   Pen1,Pen2,OldPen:HPen;
  62.   Ofs,W,H:Integer;
  63.   OldBrush:HBrush ;
  64. begin
  65.      Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  66.   OldPen := SelectObject(PaintDC,Pen1);
  67.   OldBrush := SelectObject(PaintDC,GetStockObject(null_Brush));
  68.   Rectangle(PaintDC,X1,Y1,X2,Y2);
  69.   SelectObject(PaintDC,OldPen);
  70.   SelectObject(PaintDC,OldBrush);
  71.   DeleteObject(Pen1);
  72.   Ofs := Byte(State = SR_RECESSED) * lw;
  73.  
  74.     LPts[0].x := X1+Ofs;   LPts[0].y := Y2-Ofs;
  75.     LPts[1].x := X1+Ofs;   LPts[1].y := Y1+Ofs;
  76.   LPts[2].x := X2-Ofs;   LPts[2].y := Y1+Ofs;
  77.   RPts[0].x := X1+Ofs;   RPts[0].y := Y2-Ofs;
  78.     RPts[1].x := X2-Ofs;   RPts[1].y := Y2-Ofs;
  79.     RPts[2].x := X2-Ofs;   RPts[2].y := Y1+Ofs;
  80.   if State = SR_RAISED then
  81.       begin
  82.         Pen1 := CreatePen(ps_Solid,LW,$00FFFFFF);
  83.     Pen2 := CreatePen(ps_Solid,LW,$00000000);
  84.     end
  85.   else
  86.       begin
  87.       Pen1 := CreatePen(ps_Solid,LW,$00000000);
  88.         Pen2 := CreatePen(ps_Solid,LW,$00FFFFFF);
  89.     end;
  90.  
  91.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  92.   PolyLine(PaintDC,LPts,3);
  93.   SelectObject(PaintDC,Pen2);
  94.   DeleteObject(Pen1);
  95.   PolyLine(PaintDC,RPts,3);
  96.   SelectObject(PaintDC,OldPen);
  97.   DeleteObject(Pen2);
  98. end;
  99.  
  100. {Courtesy of Neil Rubenstein on CIS}
  101. function ICOtoBMP(FileName:PChar):HBitmap;
  102. {$I-}
  103. type
  104. IcoHeader = Record
  105.     icoReserved0:Word;
  106.   icoResourceType1:Word;
  107.   icoResourceCount:Word;
  108. end;
  109. IcoDescript = Record
  110.     Width,Height,ColorCount:Byte;
  111.   Reserved1:Byte;
  112.   Reserved2,Reserved3:Word;
  113.   icoDIBSize:LongInt;
  114.   icoDIBOffset:LongInt;
  115. end;
  116. var
  117.     F:File;
  118.   iH:IcoHeader;
  119.   iD:icoDescript;
  120.   ImNum,N:Word;
  121.   Buf:Array[0..60] of Char;
  122.   imSize,imOfs:LongInt;
  123.   hNu:hBitmap;
  124.   BI:PBitmapInfo;
  125.   BitData:Pointer;
  126.   Path,Dir,Name,Ext:Array[0..79] of Char;
  127.   DC:hDC;
  128. const
  129.     BISize:Word = sizeof(TBitmapInfoHeader)+16*sizeof(TRGBQuad);
  130.  
  131.     procedure Cleanup;
  132.   begin
  133.     Close(F);
  134.     if IOresult <> 0  then  ;
  135.       if Bitdata <> nil then
  136.         FreeMem(BitData,BI^.bmiHeader.biSizeImage);
  137.     if BI <> nil then FreeMem(BI,BISize);
  138.   end;
  139.  
  140. begin
  141.     IcoToBMP := 0;
  142.   FileSplit(FileName,Dir,Name,Ext);
  143.   StrCat(StrCat(StrCopy(Path,Dir),Name),'.ICO');
  144.   Assign(F,Path);
  145.   Reset(F,1);
  146.   if IOResult <> 0 then Exit;
  147.   BI := Nil;
  148.   bitData := nil;
  149.     BlockRead(F,IH,sizeof(IH));
  150.   if (IOResult <> 0) or (IH.icoReserved0 <> 0) or (IH.icoResourceType1 <> 1) then
  151.       begin
  152.     Cleanup;
  153.     Exit;
  154.     end;
  155.   imNum := IH.icoResourceCount;
  156.   N :=0;imSize := 0;imOfs := 0;
  157.   While (N < imNum) and (imOfs = 0) DO
  158.       begin
  159.     BlockRead(F,ID,sizeof(ID));
  160.     if IOresult <> 0 then
  161.         begin
  162.       Cleanup;
  163.       exit;
  164.       End;
  165.     if (ID.width=32) and (ID.height=32) and (ID.colorCount=16) then
  166.         begin
  167.       imSize := ID.icoDibSize;
  168.       imOfs :=  ID.icoDibOffset;
  169.       end;
  170.     Inc(N);
  171.     end;
  172.   if imOfs <> 0 then
  173.       begin
  174.     GetMem(BI,BISize);
  175.     Seek(F,imOfs);
  176.     BlockRead(F,BI^,BISize);
  177.     with BI^.bmiHeader do
  178.         begin
  179.       biHeight := 32;
  180.       biSizeImage := (biWidth div 2)* biHeight;
  181.       end;
  182.     GetMem(BItData,BI^.bmiHeader.biSizeImage);
  183.     BlockRead(F,bitData^,BI^.bmiHeader.biSizeImage);
  184.     DC:=CreateDC('Display',nil,nil,nil);
  185.     ICOToBMP := CreateDiBitmap(DC,BI^.bmiHeader,cbm_Init,bitData,BI^,DIB_RGB_COLORS);
  186.     DeleteDC(DC);
  187.     end;
  188.   CleanUP;
  189. end;
  190.  
  191. {*****************************  TODButton  *************************}
  192. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  193.        X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  194. begin
  195.     TRadioButton.Init(AParent,AnID,ATitle,X1,Y1,W1,H1,AGroup);
  196.   Attr.Style :=  Attr.Style or bs_OwnerDraw;
  197.   HBmp := LoadBitmap(HInstance,BMP);
  198.   X:= X1;Y:= Y1;H:=H1;W:= W1;
  199.   State := SR_RAISED;
  200. end;
  201.  
  202. destructor    TODButton.Done;
  203. begin
  204.     DeleteObject(HBmp);
  205.     TButton.Done;
  206. end;
  207.  
  208. procedure    TODButton.DrawItem(var Msg:TMessage);
  209. var
  210.     TheDC,MemDC:HDc;
  211.   OldBitMap:HBitMap;
  212.   PDIS :^TDrawItemStruct;
  213.   PenWidth,OffSet:Integer;
  214.   GKS,OldState:Integer;
  215. begin
  216.     PDIS := Pointer(Msg.lParam);
  217.   If IsIconic(hWindow) then Exit;
  218.   OldState := State;
  219.     if Group = NIL then
  220.       begin
  221.       if PDIS^.itemAction = oda_Focus then Exit;
  222.         if ((PDIS^.itemAction and oda_Select ) > 0) and
  223.           ((PDIS^.itemState and ods_Selected) > 0) then
  224.         State := SR_RECESSED else State := SR_RAISED;
  225.       end
  226.   else 
  227.       begin
  228.       GKS := GetKeyState(vk_LButton);
  229.       if (PDIS^.itemAction = oda_DrawEntire)     then
  230.          State := State
  231.       else if (PDIS^.itemAction = oda_Select) and
  232.               (PDIS^.ItemState = ods_Selected + ods_Focus)
  233.           then State := SR_RECESSED
  234.       else if (PDIS^.itemAction = 2) and
  235.               (PDIS^.ItemState = ods_Focus) and (GKS < 0)
  236.           then State := SR_RAISED
  237.       else Exit;
  238.       end;
  239.   if (State <> OldState) then
  240.           SendMessage(Parent^.HWindow,wm_User+um_ButtonU+State,GetId,0);
  241.     offset := 2;
  242.   PenWidth := OffSet;
  243.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  244.   OldBitMap := SelectObject(MemDC,HBMP);
  245.   if State = SR_RAISED then BitBlt(PDIS^.HDC,0,0,W,H, MemDC,0,0,SrcCopy)
  246.       else BitBlt(PDIS^.HDC,OffSet,OffSet,W,H, MemDC,0,0,SrcCopy);
  247.   SelectObject(MemDC,OldBitMap);
  248.   DeleteDC(MemDC);
  249.   DrawHiLites(PDIS^.hDC,0,0,W,H,1,State);
  250. end;
  251.  
  252. procedure TODButton.WMRButtonDown(var Msg:TMessage);
  253. begin
  254.     SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,Integer(GetID),0);
  255. end;
  256. {********************* TODDButton  *****************************}
  257. constructor TODDButton.Init(AParent:PwindowsObject;AnID:Integer;ATitle:PChar;
  258.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  259. begin
  260.     TODButton.Init(AParent,AnId,ATitle,X1,Y1,W1,H1,IsDefault,'',AGroup);
  261.   if BMP <> NiL then
  262.       StrCopy(SourceName,BMP)
  263.     else StrCopy(SourceName,'');
  264. end;
  265.  
  266. procedure TODDButton.SetupWindow;
  267. begin
  268.     TODButton.SetupWindow;
  269.   DragAcceptFiles(HWindow,TRUE);
  270.     GetBMP;
  271. end;
  272.  
  273. function TODDButton.CanClose:Boolean;
  274. begin
  275.     DragAcceptFiles(HWindow,FALSE);
  276.     CanClose := TODButton.CanClose;
  277. end;
  278.  
  279. procedure TODDButton.WMDropFiles(var Msg:TMessage);
  280. var
  281.     DropItem:hDrop;
  282.   FileNameBuf:Array[0..fsPathName] of Char;
  283.   NewIcon:hIcon;
  284.   GFileName:PChar;
  285.   CtrlID:Integer;
  286. begin
  287.     DropItem := Msg.wParam;
  288.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  289.   GFileName :=StrNew(FileNameBuf);
  290.   StrCopy(SourceName,FileNameBuf);
  291.   GetBMP;
  292.   DragFinish(DropItem);
  293.   CtrlID := GetID;
  294.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  295.   StrDispose(GFileName);
  296. end;
  297.  
  298. procedure TODDButton.ChangeBMP(BMPFile:PChar);
  299. begin
  300.   StrCopy(SourceName,BMPFile);
  301.   GetBMP;
  302. end;
  303.  
  304. procedure TODDButton.GetBMP;
  305. var
  306.   Icon:hIcon;
  307.   MemDC,MemDC2,DC:HDC;
  308.   OldBmp,OldBMP2:HBitmap;
  309.   OldBrush:HBrush;
  310.   DIBmp:HBitmap ;
  311. begin
  312.     if HBmp > 0 then DeleteObject(HBmp);
  313.     Icon := 0; DIBmp := 0; HBmp := 0;
  314.   Icon := ExtractIcon(HInstance,SourceName,0);  {try to get an icon out of source}
  315.   if Icon < 2 then                              {well, see if it's an .ICO file}
  316.       DIBmp := ICOtoBMP(SourceName);
  317.   if DiBmp = 0 then                             {last resort - see if it's an internal resource}
  318.       DIBmp :=LoadBitmap(HInstance,SourceName);
  319.   DC := GetDC(HWindow);
  320.   hBmp := CreateCompatibleBitmap(DC,W,H);
  321.   MemDC := CreateCompatibleDC(DC);
  322.   OldBmp := SelectObject(MemDC,hBmp);
  323.   OldBrush := SelectObject(MemDC,GetStockObject(ltGray_Brush));
  324.   PatBlt(MemDC,0,0,Pred(W),Pred(H),PatCopy);
  325.   if Icon >1 then
  326.       DrawIcon(MemDC,1,1,Icon)
  327.   else if DIBmp >0 then
  328.       begin
  329.     MemDC2 := CreateCompatibleDC(DC);
  330.     OldBmp2 :=SelectObject(MemDC2,DIBmp);
  331.       BitBlt(MemDC,1,1,Pred(W),Pred(H),MemDC2,0,0,SrcCopy);
  332.     SelectObject(MemDC2,OldBmp2);
  333.     DeleteObject(DIBmp);
  334.     DeleteDC(MemDC2);
  335.     end
  336.   else
  337.       Rectangle(MemDC,0,0,W,H);
  338.   SelectObject(MemDC,OldBmp);
  339.   SelectObject(MemDC,OldBrush);
  340.   DeleteDC(MemDC);
  341.   ReleaseDC(hWindow,DC);
  342.   InvalidateRect(HWindow,nil,True);
  343. {  UpdateWindow(HWindow); }
  344. end;
  345. {******************  TODGroupBox   ******************************}
  346. constructor TODGroupBox.Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
  347.       X,Y,W,H:Integer);
  348. begin
  349.     TGroupBox.Init(AParent,AnId,AText,X,Y,W,H);
  350.   Attr.Style := Attr.Style {and not ws_Visible};
  351.   OldID := 0;
  352. end;
  353.  
  354. procedure TODGroupBox.SelectionChanged(NewID:Integer);
  355. begin
  356.     TGroupBox.SelectionChanged(NewID);
  357.   if NewID = OldID then
  358.       Exit;
  359.     If OldID = 0 then
  360.     OldID := NewID
  361.   else
  362.       begin
  363.     PODButton(Parent^.ChildWithID(OldID))^.State := SR_RAISED;
  364.     InvalidateRect(Parent^.ChildWithID(OldID)^.HWindow,nil,True);
  365.     OldID := NewID;
  366.     end;
  367. end;
  368. {*************************  TODDGroupBox     **************************}
  369. procedure TODDGroupBox.SetupWindow;
  370. begin
  371.     TODGroupBox.SetupWindow;
  372.   DragAcceptFiles(HWindow,TRUE);
  373.   SetClassWord(HWindow,GCW_HBRBACKGROUND,GetStockObject(LTGRAY_BRUSH));
  374. end;
  375.  
  376. function TODDGroupBox.CanClose:Boolean;
  377. begin
  378.     DragAcceptFiles(HWindow,FALSE);
  379.     CanClose := TGroupBox.CanClose;
  380. end;
  381.  
  382. procedure TODDGroupBox.WMDropFiles(var Msg:TMessage);
  383. var
  384.     DropItem:hDrop;
  385.   FileNameBuf:Array[0..fsPathName] of Char;
  386.   NewIcon:hIcon;
  387.   MemDC,DC:HDC;
  388.   OldBmp,NewBmp:HBitmap;
  389.   OldBrush:HBrush;
  390.   GFileName:PChar;
  391.   CtrlID:Integer;
  392.   Loc,SLoc:TPoint;
  393.   ChildWin:HWnd;
  394. begin
  395.     DropItem := Msg.wParam;
  396.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  397.   GFileName :=StrNew(FileNameBuf);
  398.   DragQueryPoint(DropItem,Loc);
  399.   DragFinish(DropItem);
  400.   SLoc := Loc;
  401.   ClienttoScreen(HWindow,SLoc);
  402.   ChildWin := WindowFromPoint(SLoc);
  403.   CtrlID := GetDlgCtrlID(ChildWin);
  404.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  405.   StrDispose(GFileName);
  406. end;
  407. end.
  408.